#	$LAAS$

#
#  Copyright (c) 2001-2003,2010 LAAS/CNRS             --  Sat Oct  6 2001
#  All rights reserved.                                    Anthony Mallet
#
#
# Redistribution  and  use in source   and binary forms,  with or without
# modification, are permitted provided that  the following conditions are
# met:
#
#   1. Redistributions  of  source code must  retain  the above copyright
#      notice, this list of conditions and the following disclaimer.
#   2. Redistributions in binary form must  reproduce the above copyright
#      notice,  this list of  conditions and  the following disclaimer in
#      the  documentation   and/or  other  materials   provided with  the
#      distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE  AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY  EXPRESS OR IMPLIED WARRANTIES, INCLUDING,  BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES   OF MERCHANTABILITY AND  FITNESS  FOR  A PARTICULAR
# PURPOSE ARE DISCLAIMED.  IN NO  EVENT SHALL THE AUTHOR OR  CONTRIBUTORS
# BE LIABLE FOR ANY DIRECT, INDIRECT,  INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING,  BUT  NOT LIMITED TO, PROCUREMENT  OF
# SUBSTITUTE  GOODS OR SERVICES;  LOSS   OF  USE,  DATA, OR PROFITS;   OR
# BUSINESS  INTERRUPTION) HOWEVER CAUSED AND  ON ANY THEORY OF LIABILITY,
# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
# OTHERWISE) ARISING IN ANY WAY OUT OF THE  USE OF THIS SOFTWARE, EVEN IF
# ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#

# Make packages in that directory available
eval lappend auto_path .
if { [info exists env(ELTCLLIBPATH)] } {
   eval lappend auto_path $env(ELTCLLIBPATH)
}

# Install default signal handlers (if the signal command exists)
if { [info command signal] != "" } { namespace eval el {
      proc sighandler { signal severity } {
         if {$signal != "INT"} {
            switch $severity {
               "fatal" {
                  puts ""
                  puts "*** Got signal SIG$signal"
                  while { 1 } {
                     puts -nonewline "*** Choose 1: continue, 2: exit > "
                     flush stdout
                     set c [el::getc]
                     switch $c {
                        1 { puts $c; break; }
                        2 { puts $c; exit }
                        "\n" { }
                        "\r" { }
                        default { puts $c }
                     }
                  }
               }
            }
         }
      } 
      
      signal INT [namespace code "sighandler INT fatal"]
   }
}

# Require command-line completion
if {[catch {
    package require el::tools
    package require el::complete
} m]} { puts $m }

# Preload packages
if {[info exists ::argv]} {
   while {[set i [lsearch -exact $::argv -package]] >= 0} {
      set pkgname [lindex $::argv [expr $i+1]]
      if {[catch {package require $pkgname} m]} {
         puts "$m"
         puts "cannot load $pkgname"
      } else {
         puts "loaded $pkgname package"
      }
      
      set ::argv [lreplace $::argv $i [expr $i+1]]
   }
   
   unset i
   catch { unset pkgname }
}

proc getcwd {} {
   global env
   set cwd [pwd]
   set home $env(HOME)
   regsub -all $home $cwd ~ string

   return $string
}

proc el::prompt1 {} {
   global tcl_platform 
   set var [split [info hostname] .]
   set host [string trim [lindex $var 0]]
   set count [::el::history count]
   set prompt [format "%s (%d): \[%s\]$ " $host $count [getcwd]]
}

proc el::prompt2 {} {
   set prompt [format "%s >> " [getcwd]]
}

# Setting alias commands
# To remove an alias, remove the alias line and run unalias command with 
# the key name in quotes.
set el::alias(s) "sudo"
set el::alias(ping) "ping -n"
set el::alias(susy) "sudo easy_install-2.6"
set el::alias(rm) "rm -i"
set el::alias(cp) "cp -i"
set el::alias(cd..) "cd .."
set el::alias(scls) "screen -ls"

if {$tcl_platform(os) == "Linux"} {
   set el::alias(suzy) "sudo zypper"
   set el::alias(ls) "ls -NFhv -T 0 --color=tty"
   set el::alias(zy) "zypper"
   set el::alias(ufile) "/usr/bin/file"
} elseif {$tcl_platform(os) == "OpenBSD"} {
   set el::alias(ls) "ls -Fh"
   set el::alias(ufile) "/usr/bin/file"
} elseif {$tcl_platform(os) == "Darwin"} {
   set el::alias(ls) "ls -Fh"
   set el::alias(ldd) "otool -L"
   set el::alias(ufile) "/usr/bin/file"
}

if {[string length [array get el::alias ls]] > 0} {
   set el::alias(dir) $el::alias(ls)
}

set env(umask) [umask]

proc filepatmatch str {
   set retval ""
   regexp {^\*|\.\*|\?+\*$|\*$} $str retval
   return $retval
}

proc expandperm mask {
   set retval ""
   if {[string length $mask] && [string is digit -strict $mask]} {
      set max 3
      set usr "ugo"
      set perm "rwx"
      for {set ix 0} {$ix < $max} {incr ix} {
         if {[string length $retval]} {
            set retval [concat "$retval,"]
         }

         set retval [format "%s%s=" $retval [string index $usr $ix]]
         for {set jy 0} {$jy < $max} {incr jy} {
            set temp [expr [expr 3 * $ix] + $jy]
            set value [expr $mask & [expr 1 << [expr 8 - $temp]]]
            if {$value} {
               set retval [format "%s%s" $retval [string index $perm $jy]]
            }
         }
      }
   }

   return $retval
}

proc cformat tm {
   return [clock format $tm -format {%b %d, %Y @ %H:%M:%S}]
}
      
proc tfile filename {
   global tcl_platform
   if {[string length $filename]} {
      set temp [filepatmatch $filename]
      if {[file exists $filename]} {
         set writeable [file writable $filename]
         if {$writeable} {
            set writeable "yes"
         } else {
            set writeable "no"
         }

         set type [file type $filename]
         set size [file size $filename]
         set group [file attributes $filename -group]
         set perm [file attributes $filename -permissions]
         set owner [file attributes $filename -owner]
         file lstat $filename finfo
         file stat $filename st
         puts "$filename: "
         puts "owner      : $owner"
         puts "group      : $group"
         puts "type       : $type"
         puts "writeable  : $writeable"
         puts "permission : $perm ([expandperm $st(mode)])"
         puts "size       : $size bytes"
         puts "inode      : $finfo(ino)"
         puts "system     : [sysinfo]"
         puts "access     : [cformat $st(atime)]"
         puts "modified   : [cformat $st(mtime)]"
         puts "changed    : [cformat $st(ctime)]"
         puts "---"
      } elseif {[string length $temp]} {
         foreach fl [glob $filename] {
            tfile $fl
         }
      } else {
         puts "$filename does not exist"
      }
   }
}

proc remove { filename { force 0 } } {
   if {[string length $filename]} {
      set temp [filepatmatch $filename]
      if {[file exists $filename]} {
         puts -nonewline stderr "delete $filename "
         set confirm [el::gets "\[yes/no\]? "]
         flush stdout
         if {$confirm == "yes" || $confirm == "y"} {
            set writeable [file writable $filename]
            if {$writeable && $force} {
               file delete -force $filename
            } elseif {$writeable} {
               file delete $filename
            }

            if {[file exists $filename] == 0} { puts "$filename deleted!" }
         } elseif {$confirm == "no" || $confirm == "n"} {
            puts "$filename not deleted!"
         }
      } elseif {[string length $temp]} {
         foreach fl [glob $filename] {
            remove $fl $force
         }
      } else {
         puts "$filename does not exist"
      }
   }
}

proc retcode {} {
   puts [exitcode]
}

proc sysinfo {} {
   global tcl_platform
   set os $tcl_platform(os)
   set mach $tcl_platform(machine)
   return [format "%s (%s, %s)" [info hostname] $os $mach]
}

proc tgrep {pattern args} {
   set filename [list]
   set temp [filepatmatch $args]
   if {[string length $args] == 0} {
      lappend filename stdin
   } elseif {[string length $temp]} {
      foreach fl [glob $args] {
         lappend filename $fl
      }
   } else {
      foreach fl $args {
         lappend filename $fl
      }
   }

   foreach fl $filename {
      if {$fl != "stdin"} {
         if {[file isfile $fl]} {
            if {[catch {set file [open $fl r]} err]} {
               puts "tgrep: $err"
            } else {
               grep0 $pattern $file $fl
               close $file
            }
         } else {
            puts "tgrep: $fl is [file type $fl], not file"
         }
      } else {
         grep0 $pattern $fl stdin
      }
   }
}

proc grep0 {pattern handle file} {
   set lnum 0
   while {[gets $handle line] >= 0} {
      incr lnum
      if {[regexp -expanded -all -nocase $pattern $line match]} {
         puts "$file:$lnum: $line"
      }
   }
}

proc alias {} {
   global el::alias
   foreach name [array names el::alias] {
      puts "$name: $el::alias($name)"
   }
}

proc unalias name {
   global el::alias
   if {[string length $name]} {
       unset el::alias($name)
   }
}

proc strlen str {
   puts [string length $str]
}
